home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 2 / BBS in a box - Trilogy II.iso / Files / Game / R / Rhine / randomTest next >
Encoding:
Text File  |  1993-06-27  |  1003 b   |  44 lines  |  [TEXT/McSk]
  1. \ Pick a random number from 0 to n
  2. : SEED ( -- daddr ) ,$ 2d15 126 0 dnegate d+ ;
  3. : RANDOMIZE 524 0 dl@  seed dl! ;
  4. : RANDOM ( n -- n' )
  5.     0 >r ,$ A861  r> ( _Random )
  6.     swap 32768 */ abs ;  ( scale to size from stack )
  7. : 0TO4 ( -- n ) 5 random ;
  8.  
  9. variable BINS 8 allot
  10. : ZEROS  bins ;
  11. : ONES   bins 2+ ;
  12. : TWOS   ones 2+ ;
  13. : THREES twos 2+ ;
  14. : FOURS  threes 2+ ;
  15.  
  16. : SPACES ( n -- )
  17.     ?dup IF 0 DO space LOOP THEN ;  \ emit n spaces
  18. : D.R ( d width -- )
  19.     >r  swap over dabs  <# #s sign #>
  20.     r>  over - spaces type space ;
  21. : .R  ( n width -- ) >r s>d r> d.r ;
  22. : U.R ( u width -- ) 0 swap  d.r ;
  23. : .BINS ( -- ) cr
  24.     zeros @ 4 .r
  25.     ones @ 4 .r
  26.     twos @ 4 .r
  27.     threes @ 4 .r
  28.     fours @ 4 .r ;
  29.  
  30. : test ( trials -- )
  31.     bins 10 0 fill
  32.     0 DO
  33.       0to4
  34.       dup 0= IF 1 zeros +! THEN
  35.       dup 1 = IF 1 ones +! THEN
  36.       dup 2 = IF 1 twos +! THEN
  37.       dup 3 = IF 1 threes +! THEN
  38.       dup 4 = IF 1 fours +! THEN
  39.       drop
  40.     LOOP .bins ;
  41. : run begin 5000 test ?terminal until ;
  42.  
  43.  
  44.